home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / xlispst.cpt / XLisp-Stat ƒ / Disk 1 / Examples / addhandrotate.lsp < prev    next >
Encoding:
Text File  |  1990-02-28  |  1.3 KB  |  40 lines
  1. ;; add a new "mouse mode", with menu title, cusror and mouse method name
  2. (send spin-proto :add-mouse-mode 'hand-rotate
  3.       :title "Hand Rotate" :cursor 'hand :click :do-hand-rotate)
  4.  
  5. ;; set up local environment with function to project (x, y) point onto
  6. ;; "globe" overthe plot
  7. (flet ((calcsphere (x y)
  8.         (let* ((norm-2 (+ (* x x) (* y y)))
  9.                (rad-2 (^ 1.7 2))
  10.                (z (if (< norm-2 rad-2) (sqrt (- rad-2 norm-2)) 0)))
  11.           (if (< norm-2 rad-2) 
  12.               (list x y z)
  13.               (let ((r (sqrt (max norm-2 rad-2))))
  14.                 (list (/ x r) (/ y r) (/ z r)))))))
  15.                 
  16.   ;; define the :DO-HAND-ROTATE method in the local environment
  17.   (defmeth spin-proto :do-hand-rotate (x y m1 m2)
  18.     (let* ((oldp (apply #'calcsphere 
  19.             (send self :canvas-to-scaled x y)))
  20.        (p oldp)
  21.        (vars (send self :content-variables))
  22.        (trans (identity-matrix (send self :num-variables))))
  23.       (send self :idle-on nil)
  24.       (send self :while-button-down 
  25.         #'(lambda (x y) 
  26.         (setf oldp p)
  27.         (setf p (apply #'calcsphere 
  28.                    (send self :canvas-to-scaled x y)))
  29.         (setf (select trans vars vars) (make-rotation oldp p))
  30.         (when m1 
  31.               (send self :slot-value 'rotation-type trans)
  32.               (send self :idle-on t))
  33.         (send self
  34.               :apply-transformation
  35.               trans))))))
  36.  
  37.                         
  38.  
  39.  
  40.